⓪ (* ------------------------⓪#Modula Compiler /4.0/⓪#------------------------⓪#Tree-Finish⓪$⓪$28.3.85 GDOS Version⓪%8.5.85 Fehler bei Export von Variablen korrigiert⓪$10.5.85 PrtDec zehnstellig⓪$16.5.85 Fehler bei Export aus lokalen Modulen endgueltig (?) korrigiert⓪$6.10.85 (TT) Assembler-Errors in 'Massm' uebertragen⓪#22.02.86 Neuordnung der Texte⓪$2.03.86 Real-Konstanten im Hex-Format mit HexDigit {HexDigit} 'R';⓪-Wandlung von Reals jetzt ueber Strings-Modul⓪#14.04.86 Err109 nachgetragen⓪#11.07.86 Err42 entfernt⓪#08.09.86 Oktalkonstanten implementiert;⓪-Option $O waehlt Oktaldarstellung fuer Characters⓪#06.10.86 alle ErrXXX geloescht;⓪#16.10.86 statt $Oktal+ wird $Gepard- fuer Oktal-Chars abgefragt⓪#24.10.86 Constant Expressions implementiert⓪#28.10.86 Type Transfer in ConstExpr laesst verschiedene Laengen zu⓪.(mit unsinnigen Ergebnissen bei Reals)⓪$1.11.86 TravTre erkennt Relay an 0.B (Flags im Highbyte moeglich)⓪$2.11.86 in ConCard9 'D' als Suffix fuer LONGs zugelassen⓪$1.3.87 TT Anpassungen für Atari-MOS in 'ConFact'⓪$3.3.87 TT PushAcc/PopAcc nicht auf A7-Stack sondern auf ID-Stack, zus.⓪.Overflow-Abfrage⓪$24. 3.87 nicht Impl. FORWARD-Deklarationen brechen mit Fehler ab⓪/(VPKnot)⓪$07.04.87 TT RealIsUsed wird gesetzt (ConFact)⓪$18.04.87 TT ProtVar-Aufruf in VPKNOT⓪$⓪$16.06.87 ConRel: Wenn runGep & Atari-Codeerzeugung, Formatwandlung.⓪.IEEE-Fomatwandlung nur im Gepard-Modus!⓪$24.06.87 TravTr1 durchsucht auch bei lokalen Modulen die Unterbäume⓪.(wer weiß, wozu man's braucht) und ruft den Knoten-Handler⓪.auch für den Qualifier bei DefMods auf.⓪$26.06.87 Ersetzen von ^nachdeklarierte Opaues durch ^neuen Eintrag⓪.(NewOpaque)⓪$04.07.87 IDfromTree statt TravPrID zur Verarbeitung von IDs, die⓪.während TreeScan als Fehlerquelle auffallen;⓪.Procedure FwdKnot prüft auf lokale unimpl. FORWARDs⓪$08.07.87 für NewOpaque spezielle TreeScan-Routine TravTr2: erkennt⓪0Verweise auf alten Opaque-Eintrag per Relay (falls Opaque erst⓪0auf Umwegen, dann aus eigenem DefMod importiert) und ersetzt⓪0auch die.⓪.Nicht impl. Exporte jetzt durch VPKnot erkannt (statt FinExp)⓪$28.10.87 NewOpaque: Endlosschleifen beim Scannen von POINTER TO RECORD..⓪0verhindert (Markierung der bearbeiteten Einträge in Bit 3⓪0der Kennung - VARPAR-Flag, ist im globalen Level frei).⓪$07.11.87 OpqUsers: Open Array nachgetragen⓪.NewOpaque: Markierung in bit 7 statt bit 3;⓪0alle möglichen Opq-Benutzungen werden gefunden.⓪$16.11.87 NewOpq: Markierung jetzt nur noch bei Pointern, in Bit 2.⓪0Rücksetzen der Markierung durch Merken mit Pointerkette⓪0statt durch erneutes Durchsuchen!⓪$22.11.87 TT Ausgaberoutinen -> CompIO⓪$15.03.88 FinVar: Anlegen der Längenliste für Proc/Module/Tables⓪0(FinVar legt Pointerkette durch alle Einträge an, die⓪0in der Längenliste erscheinen müssen)⓪$18.05.88 FinVar: neues Format der Längenliste; enthält für jeden⓪1Eintrag Anfangsadresse und Länge.⓪$26.05.88 FacTran: Transfer von/auf 2 Byte-SETs greift nicht mehr⓪1auf falsches Wort im Akku zu⓪$29.06.88 VPKnot erkennt exportierte (nicht impl.) Prozeduren am⓪1External-Bit (bit 12) statt an bit 14.⓪%2.07.88 DoSP: holt Ergebnisse von System-Prozeduren auch bei SETs⓪1ungerader Länge richtig ab.⓪$15.12.88 ConstExpr rausgetrennt, in separates Modul⓪$10.12.89 Nachtrag vom 28.12.88⓪.TravTre: rettet beim Bearbeiten des RStacks A0⓪1(vergißt jetzt hoffentlich keine lokalen Module mehr)⓪$28.01.90 TT MovVarKnot neu; wird in M2Main.Block benutzt⓪$05.07.90 TT OpqKnot trägt nun alle Opaques in Parm-Ketten nach (hörte⓪0bisher nach dem ersten auf), auch keine Endlosschleife mehr bei⓪0rekursiven Prozedurtyp-Definitionen.⓪$18.08.90 TT Anpassung des Offsets zum lok. Record-Baum⓪$23.09.90 TT GetNameOfId findet den Namen einer ID-Beschreibung;⓪0TravTr1 & OpqKnot gehen nicht mehr durch leere Unterbäume⓪0(zumindest bei OpqKnot wurde damit ein Fehler behoben);⓪0OpqKnot berücksichtigt auch Long-OpenArrays und ProcType⓪0f. lok.Procs (Kennung 44); Importliste bei Imp-Modulen wird⓪0gekürzt (nur die wirklich benutzten IDs bleiben drin)⓪$05.03.91 TT NewOpaque/OpqKnot berücksichtigen leere Records (führte bisher⓪0zu Abstürzen).⓪$03.06.94 TT FinishData übersprang unbenutzte DATAs falsch, was zu⓪0Endlosschleifen mit Buserrors am Ende d. Speichers führte.⓪#-----------------------------------------------------⓪ *)⓪ ⓪ (* ===================================================⓪ ⓪,Low-Level Zeugs, Tree-Scanner⓪(⓪"=================================================== *)⓪ ⓪ (* Dokumentation der TravTre-Routinen:⓪ ⓪#TravTr scannt Pervasive- und aktuelles Level sowie die auf dem⓪,Relocation Stack eingetragenen lokalen Module⓪#TravTr0 scannt Pervasive-Level sowie die auf dem Relocation Stack⓪,eingetragenen lokalen Module (also wie TravTr ohne akt. Level)⓪#TravTr1 scannt nur den Unterbaum auf (A1,D2.L)⓪#⓪#Beide Routinen verfolgen lokale Bäume von Qualifiern (lokale oder⓪#Def-Module; deren Einträge müssen z.B. auch reloziert werden), jedoch⓪#nicht von Records. Relay-Einträge werden zum Ursprung verfolgt.⓪#⓪#TravTr kann einen Eintrag mehrfach erreichen: im lokalen Modul (über⓪#den Relocation Stack) und über ein Relay bei exportierten Objekten.⓪#Die Knotenhandler müssen durch geeignete Markierung der Einträge⓪#mehrfache Bearbeitung verhindern!⓪ *)⓪ ⓪ FORWARD TravTr1;⓪ FORWARD TravTr0;⓪ ⓪ (*⓪!* PROZEDUR (A5) AUF GESAMTEN BAUM ANWENDEN;⓪!*⓪!* Register bei Aufruf von (A5):⓪!* (A1,D4.L) = ^Pointerkette⓪!* -8(A1,D4.L) = ^Identifier⓪!* -8(A1,D2.L) = ^Eintrag zum Id⓪!*)⓪ ⓪ PROCEDURE TravTr;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L (A6),D2 ;GLOBAL LEVEL⓪)BEQ TravTr9 ; IST LEER⓪)JSR TravTr1⓪ TravTr9 JMP TravTr0⓪ END⓪ END TravTr;⓪ ⓪ PROCEDURE TravTr0;⓪ BEGIN⓪ ASSEMBLER⓪); Relocation Stack abarbeiten (lokale Module)⓪)MOVE.L RSTKPTR,-(A7)⓪ TravTr3 MOVE.L (A7)+,A0⓪)MOVE.L (A0)+,D2⓪)BNE L1⓪)JMP TravTr1 ;PERVASIVES⓪ L1 MOVE.L A0,-(A7)⓪)JSR TravTr1⓪)BRA TravTr3⓪ END⓪ END TravTr0;⓪ ⓪ (*⓪!* wie TravTre, jedoch wird nur der Unterbaum ab (A1,D2.L) durchsucht:⓪!*⓪!* Vorsicht: LOCXP/SetRelay verwendet D4 um an den ggf. Relay-Eintrag zu kommen.⓪!*)⓪ ⓪ PROCEDURE TravTr1;⓪ BEGIN⓪ ASSEMBLER⓪ !TRAVT1L MOVE.L D2,-(A7)⓪)MOVE.L -4(A1,D2.L),D2 ;LINKEN AST VERFOLGEN⓪)BEQ TravTr2⓪)BSR TRAVT1L⓪ !TravTr2 MOVE.L (A7),D2⓪)MOVE.L -8(A1,D2.L),D2 ;RECHTEN AST VERFOLGEN⓪)BEQ TravTr4⓪)BSR TRAVT1L⓪ !TravTr4 MOVE.L (A7)+,D2⓪)MOVE.L D2,D4 ;retten fuer ID-Ausgabe⓪ !TravTr5 SUBQ.L #2,D2 ;ID WEG⓪)CMPI.W #$FE00,-8(A1,D2.L)⓪)BCS TravTr5 ;noch keine Endmarke⓪)MOVE.W -10(A1,D2.L),D0 ;KENNUNG⓪)TST.B D0⓪)BNE TravTr7 ;KEIN RELAY⓪)MOVE.L -14(A1,D2.L),D2⓪)ADDQ.L #8,D2 ;UEBLICHEN OFFSET WIEDERHERSTELLEN⓪)MOVE.W -10(A1,D2.L),D0⓪)TST.B D0⓪)BNE TravTr7 ;KEIN RELAY⓪)MOVE #rTree2,D5 ;Fehler: Doppelte Relay-Verkettung⓪)JMP SyntaxErr⓪ !TravTr7 TST.W D0⓪)BPL TravTr6 ;MODULA WORT⓪)CMPI.B #15,D0 ;lokales Modul ?⓪)BEQ L3⓪)CMPI.B #16,D0 ;QUALIFIER?⓪)BNE L2⓪ L3 MOVEM.L D0/D2/D4,-(A7)⓪)MOVE.L -14(A1,D2.L),D2⓪)BEQ L4 ;leer⓪)JSR TravTr1 ;UNTERBAUM DURCHSUCHEN⓪ L4 MOVEM.L (A7)+,D0/D2/D4⓪ L2 JMP (A5)⓪ !TravTr6⓪ END⓪ END TravTr1;⓪ ⓪ (*⓪(gefundenen ID waehrend TravTre in 'BadID' schreiben;⓪(wahlweise Gepard- oder Atari-Stringformat.⓪(⓪((A1,D4.L) zeigt auf PointerKette⓪(⓪((A0,D0,D1,D4)⓪ *)⓪!⓪ PROCEDURE IDfromTree;⓪ ⓪ BEGIN ASSEMBLER⓪.LEA BadID,A0⓪ (*$ ? RunGep: ADDQ.L #1,A0 ;Platz für Längenzähler *)⓪.CLR.W D1⓪&TP1 SUBQ.L #1,D4⓪.MOVE.B -8(A1,D4.L),D0⓪.CMP.B #$FE,D0⓪.BCC TP2⓪.MOVE.B D0,0(A0,D1.W)⓪.ADDQ #1,D1⓪.BRA TP1⓪&TP2⓪ (*$ ? RunGep: MOVE.B D1,-1(A0) ;Längenzähler *)⓪ (*$ ? RunST: CLR.B 0(A0,D1.W) ;Endmarke *)⓪'END⓪ END IDfromTree;⓪ ⓪ PROCEDURE FLKNOT;⓪ BEGIN ASSEMBLER⓪)CMPI.B #29,D0 ; Asm-Label⓪)BNE FLKNOT1⓪)TST.L -14(A1,D2.L)⓪)BNE FLKNOT1⓪)JMP AERR6⓪ FLKNOT1 CMPI.B #48,D0 ; FORWARD⓪)BNE FLKNOT2⓪)JSR IDfromTree⓪)MOVE #rFwTyX,D5⓪)JMP SyntaxErr⓪ FLKNOT2⓪ END⓪ END FLKNOT;⓪ ⓪ (*⓪!* PRUEFEN, OB noch LABELS undefiniert oder Forward-Typen übrig.⓪!*)⓪!⓪ PROCEDURE FinLblAndFwrd;⓪ BEGIN ASSEMBLER⓪)LEA FLKNOT,A5⓪)MOVE.L (A6),D2⓪)BEQ EMPTY⓪)JMP TravTr1⓪ !EMPTY⓪ END⓪ END FINLBLAndFwrd;⓪ ⓪ ⓪ (*⓪!* Alle globalen Objekte in die Relozierliste eintragen.⓪!*)⓪ ⓪ VAR ImpOffset: LONGCARD;⓪$DataCodeOffs: LONGCARD;⓪$CurrDataOfs: LONGCARD;⓪ ⓪ PROCEDURE movReloc;⓪"BEGIN⓪$ASSEMBLER⓪);Relozierkette einer ID korrigieren⓪)MOVE.L D1,D0⓪)SUB.L D7,D0⓪)MOVE.L D0,(A4)+ ;^letzte Ref. gleich mit ablegen⓪)BRA relCont⓪ relNext MOVE.L D1,D0⓪)SUB.L D7,D0⓪)MOVE.L D0,(A0)⓪ relCont LEA 0(A2,D1.L),A0 ;Adr. der vorigen Ref. nach A0⓪)MOVE.L (A0),D1⓪)BNE relNext⓪$END⓪"END movReloc;⓪ ⓪ PROCEDURE RelocData;⓪"BEGIN⓪$ASSEMBLER⓪)MOVE.L DataStart,A0⓪)MOVE.L DataCodeOffs,A3⓪)SUBA.L CodeStart,A3 ;A3: Beginn v. DATA rel. zum Codebeginn⓪ lup20: CMPA.L DataPtr,A0⓪)BEQ endOfD2⓪)MOVE.L 2(A0),D1 ;^letzte Ref.⓪)BEQ ignore⓪)MOVE.L A0,-(A7)⓪)JSR movReloc ;Relozierkette korrigieren & eintragen⓪)MOVE.L (A7)+,A0⓪)MOVE.L A3,D0 ;D0: Adr. der. Konst rel. zum Code-Beginn⓪)SUB.L D7,D0 ; ImportList-Korrektur⓪)MOVE.L D0,(A4)+⓪)ADDA.W (A0),A3⓪ ignore: ADDA.W (A0),A0⓪)ADDQ.L #6,A0⓪)BRA lup20⓪ endOfD2: MOVE.L A3,CurrDataOfs ; f. VPKNOT merken⓪$END⓪"END RelocData;⓪ ⓪ FORWARD VPKNOT;⓪ ⓪ PROCEDURE FINVAR;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L A2,-(A7)⓪)MOVE.L A3,-(A7)⓪ ⓪)MOVE.L options,D0⓪)BTST #16,D0⓪)BEQ hcr3 ;p- gesetzt: kein Protokoll⓪)TST.W ProtFile⓪)BEQ hcr3 ;ProtokollFile nicht offen⓪)JSR ProtVarStart ;Variablen ankündigen⓪ hcr3⓪)MOVE.L Header,A2⓪)MOVE.L 22(A2),D3 ;OFFSET FUER VAR-ADRESSEN⓪);minus der Header-Länge (nun Codelänge):⓪)ADD.L A2,D3⓪)SUB.L CodeStart,D3⓪)⓪)MOVE.L ImpOffset,D7⓪)⓪)JSR RelocData ;zuerst die Daten aus dem DATA-Puffer relozieren⓪)⓪)LEA root(pc),A3 ;Root z. Verkett. d. Clienten f. d. Längenliste⓪)CLR.L (A3)⓪)⓪)LEA VPKNOT,A5⓪)MOVE.L CodeStart,A2⓪)JSR TravTr ;IM GANZEN BAUM SUCHEN⓪)CLR.L (A4)+⓪)⓪); Proc-Namen-Liste korrigieren, falls vorhanden⓪)TST.W ProcNames⓪)BEQ noName ;Name ist nicht gefragt⓪)MOVE.L 6(A2),D0 ;^Body⓪ nxtLbl LEA -4(A2,D0.L),A0⓪)MOVE.L (A0),D0⓪)BEQ noName⓪)MOVE.L D0,D1⓪)SUB.L D7,D1⓪)MOVE.L D1,(A0)⓪)BRA nxtLbl⓪ noName⓪); Nun werden ExportListe & Programmcode verschoben (wg. gekürzter⓪); Importliste)⓪)⓪)MOVE.L Header,A2⓪)MOVE.L 42(A2),A0 ;Codebeginn⓪)SUB.L D7,42(A2) ; ...korrigiert⓪)MOVE.L 18(A2),D0 ;Exportliste⓪)BEQ noExpLst⓪)MOVE.L D0,A0⓪)SUB.L D7,D0⓪)MOVE.L D0,18(A2) ; ...korrigiert⓪ noExpLst ; A0 enthält nun Beginn des zu verschiebenden Bereichs⓪)ADDA.L A2,A0⓪)MOVEM.L D0-D2/A0-A3,-(A7)⓪)MOVE.L EvalStk,A3⓪)MOVE.L A0,(A3)+ ;Source-Start⓪)MOVE.L A4,D0⓪)SUB.L A0,D0⓪)MOVE.L D0,(A3)+ ;Anzahl⓪)SUBA.L D7,A0⓪)MOVE.L A0,(A3)+ ;Dest-Start⓪)JSR Copy⓪)MOVEM.L (A7)+,D0-D2/A0-A3⓪ ⓪); Die restlichen Ptr korrigieren⓪)SUB.L D7,6(A2) ;^Body⓪)SUB.L D7,10(A2) ;^Modulende⓪)SUB.L D7,22(A2) ;^Relozierliste⓪)SUB.L D7,62(A2) ;^Data⓪)SUBA.L D7,A4⓪ ⓪); Längenliste anlegen & gleich korrigeren⓪)⓪)MOVE.L Header,A0 ;^Längenliste setzen⓪)MOVE.L A4,D0⓪)SUB.L A0,D0⓪)MOVE.L D0,38(A0)⓪)⓪); zuerst die Längenliste für die Konstanten aus dem DATA-Puffer⓪)MOVE.L DataStart,A0⓪)MOVE.L DataCodeOffs,A3⓪)SUBA.L CodeStart,A3 ;A3: Beginn v. DATA rel. zum Codebeginn⓪ lup20: CMPA.L DataPtr,A0⓪)BEQ endOfD2⓪)MOVE.L 2(A0),D1 ;^letzte Ref.⓪)BEQ ignore⓪)MOVE.L A3,D0 ;D0: Adr. der. Konst rel. zum Code-Beginn⓪)SUB.L D7,D0 ; ImportList-Korrektur⓪)MOVE.L D0,(A4)+⓪)MOVEQ #0,D0⓪)MOVE.W (A0),D0 ;Länge d. CONST⓪)MOVE.L D0,(A4)+⓪)ADDA.W D0,A3⓪ ignore: ADDA.W (A0),A0⓪)ADDQ.L #6,A0⓪)BRA lup20⓪ endOfD2:⓪)MOVE.L root(pc),A0⓪)MOVE.L A0,D0⓪)BEQ empty⓪)⓪ cont BCLR #0,D0 ;ist es eine CONST?⓪)BNE isConst⓪)MOVE.L -8(A0),D0⓪)SUB.L D7,D0 ;ImpOffset (Korrektur)⓪)MOVE.L D0,(A4)+ ;Adresse⓪)MOVE.L -4(A0),(A4)+ ;Länge⓪ cont2 MOVE.L (A0),A0⓪)MOVE.L A0,D0⓪)BNE cont⓪)⓪ empty MOVEQ #0,D0⓪)MOVE.L D0,(A4)+⓪)⓪)MOVEA.L (A7)+,A3⓪)MOVEA.L (A7)+,A2⓪)RTS⓪ ⓪); CONST in Längenliste aufnehmen geht anders:⓪ isConst MOVE.L D0,A0⓪)MOVE.L 8(A0),(A4)+ ;Adresse (bereits D7-korrigiert)⓪)MOVEQ #0,D0⓪)MOVE.W -2(A0),D0 ;Länge⓪)MOVE.L D0,(A4)+⓪)BRA cont2⓪ ⓪ root DC.L 0⓪ END⓪ END FINVAR;⓪ ⓪ PROCEDURE VPKNOT;⓪ BEGIN⓪ ASSEMBLER⓪);D3: Länge des Codes, Offset der glob. Vars⓪);D7: Korrektur-Offset der Importliste⓪)⓪)BSET #5,-10(A1,D2.L) ;IMPORTIERT?⓪)BNE ok ;dann nicht⓪)⓪)CMP.B #15,D0 ;MODULE?⓪)BEQ VPKNOT1⓪)CMP.B #6,D0 ;PROC?⓪)BNE.W VPKNOT3⓪)⓪); Procedure⓪)⓪)MOVE.L -14(A1,D2.L),D5 ;Adr⓪)BEQ noImpl ;Implementation fehlt⓪)MOVE.L -26(A1,D2.L),D1 ;^letzte Ref⓪)BEQ noRef ;keine Referenz⓪)JSR movReloc⓪)SUB.L D7,D5⓪)MOVE.L D5,(A4)+⓪ noRef LEA -26(A1,D2.L),A0 ;Pointerkette für Längenliste aufbauen⓪)MOVE.L A0,(A3)⓪)MOVE.L A0,A3⓪)CLR.L (A3)⓪ ok RTS⓪ ⓪ noImpl JSR IDfromTree⓪)BTST #4,-10(A1,D2.L) ;exportiert?⓪)BEQ noExp⓪)MOVE #rPrIpl,D5⓪)BRA isExp⓪ noExp MOVE #rUnFw,D5⓪ isExp JMP SyntaxErr⓪)⓪); Module⓪)⓪ VPKNOT1 MOVE.L -30(A1,D2.L),D1 ;^letzte Ref⓪)BEQ noRef2 ;keine Referenz: nicht in RelocListe⓪)JSR movReloc⓪)MOVE.L -18(A1,D2.L),D0 ;Adr⓪)SUB.L D7,D0⓪)MOVE.L D0,(A4)+⓪ noRef2 LEA -30(A1,D2.L),A0 ;Pointerkette für Längenliste aufbauen⓪)MOVE.L A0,(A3)⓪)MOVE.L A0,A3⓪)CLR.L (A3)⓪)RTS⓪)⓪ VPKNOT3 CMP.B #17,D0⓪)BNE VPKNOT4⓪)⓪); Variable⓪)⓪)MOVE.L -22(A1,D2.L),D1 ; letzte Ref.⓪)BEQ ok⓪)JSR movReloc⓪)MOVE.L -14(A1,D2.L),D0 ; Adr.⓪)ADD.L D3,D0 ;VAR-OFFSET DAZU⓪)SUB.L D7,D0 ;ImportList-Korrektur⓪)MOVE.L D0,(A4)+⓪)⓪); Variable ggf. protokollieren⓪)⓪)MOVE.L options,D0⓪)BTST #16,D0⓪)BEQ hcr3 ;p- gesetzt: kein Protokoll⓪)TST.W ProtFile⓪)BEQ hcr3 ;ProtokollFile nicht offen⓪)JSR ProtVar ;Variablenname/Adresse ins Protokollfile⓪ hcr3 RTS⓪ ⓪ !VPKNOT4 CMP.B #28,D0 ;TABLE im Code-Segment⓪)BNE VPKNOT5⓪)MOVE.L -18(A1,D2.L),D1⓪)BEQ noRef3⓪)JSR movReloc⓪)MOVE.L -14(A1,D2.L),D0⓪)SUB.L D7,D0⓪)MOVE.L D0,(A4)+⓪ noRef3 LEA -18(A1,D2.L),A0 ;Pointerkette für Längenliste aufbauen⓪)MOVE.L A0,(A3)⓪)MOVE.L A0,A3⓪)CLR.L (A3)⓪)RTS⓪ ⓪ VPKNOT5 CMP.B #50,D0 ;CONST hinter Code-Segment⓪)BNE VPKNOT2⓪)BCLR #2,-8-2(A1,D2.L)⓪)BEQ hcr3 ; -> bereits bearbeitet oder unbenutzt⓪); dieses Datum wurde in den Code kopiert⓪)MOVE.L CurrDataOfs,D0 ;D0: Adr. der. Konst rel. zum Code-Beginn⓪)MOVE.L D0,A0⓪)SUB.L D7,D0 ; ImportList-Korrektur⓪)MOVE.L D0,-8-6(A1,D2.L) ;Adr. merken (f. FINVAR & FINEXP)⓪); Offset zum nächsten Datum im Code bestimmen:⓪)ADDA.W -8-16(A1,D2.L),A0 ;echte Länge im DATA-Segment aufaddieren⓪)MOVE.L A0,CurrDataOfs⓪); Relozierkette aufbauen⓪)MOVE.L -8-14(A1,D2.L),D1 ;^letzte Ref⓪)BEQ ignore ;unbenutzt? (dann wird sie aber exportiert)⓪)JSR movReloc ;Relozierkette korrigieren & eintragen⓪)MOVE.L -8-6(A1,D2.L),(A4)+⓪ ignore ;Pointerkette für Längenliste aufbauen⓪);bei Consts geht das so: Die Verkettung geschieht über den⓪); "^letzte Ref" im Tree.⓪); So findet FINVAR am Ende zum Aufbau der Längenliste die Ptr⓪); als Zeiger auf ein Längen-Word und eine Long-Adr.⓪); Um dies von den Procs/Tables usw. zu unterscheiden, bei denen⓪); der Ptr auf ein Längen-Long und ein Adr-Long zeigt,⓪); wird das Bit 0 des Ptrs gesetzt.⓪)LEA -8-14(A1,D2.L),A0 ;A0: Adr. des nicht mehr benutzten ^Ref⓪)ADDQ.L #1,A0 ;als CONST markieren⓪)MOVE.L A0,(A3)⓪)SUBQ.L #1,A0⓪)MOVE.L A0,A3⓪)CLR.L (A3)⓪ ⓪ VPKNOT2:⓪ END⓪ END VPKNOT;⓪ ⓪ ⓪ (*⓪$Relozierliste der importierten Vars, Procs & Consts nacharbeiten.⓪$⓪$In den Einträgen für die Adr. von importierten Vars/Procs/Consts zeigt⓪$ein Ptr auf die Stelle in der Importliste, wo der Ptr auf die⓪$letzte Ref. des Items einzutragen ist. Dies wird hier getan.⓪$⓪$Außerdem wird die Importliste so gekürzt, daß nur noch die⓪$wirklich benutzten Vars/Procs/Consts drin stehen.⓪ *)⓪ ⓪ FORWARD FIKNOT;⓪ ⓪ PROCEDURE FinImp;⓪ BEGIN⓪ ASSEMBLER⓪); Zuerst die Ptr eintragen⓪)MOVE.L A2,-(A7)⓪)MOVE.L Header,A2⓪)ADDA.L 14(A2),A2 ;^Importliste⓪)LEA FIKNOT,A5⓪)JSR TravTr ; scannen des Relocation Stack⓪@; ist hier eigentlich überflüssig⓪)⓪); Nun die Importliste kürzen; dazu alle Null-Einträge löschen⓪)MOVE.L Header,A2⓪)ADDA.L 14(A2),A2 ;^Importliste⓪)MOVE.L A2,A0 ; A2: Source-, A0: Dest-Pointer⓪)⓪ nextkey MOVE.L (A2)+,(A0)+ ;Key⓪)BEQ ende ;ende der Importlisten⓪ ImpRest4 MOVE.W (A2)+,D0 ;Namen kopieren⓪)MOVE.W D0,(A0)+⓪)CMP.B #$FE,D0⓪)BCS ImpRest4⓪ next MOVE.W (A2)+,(A0)+ ;ItemNr kopieren⓪)BEQ nextkey ;Ende dieser Liste⓪)MOVE.L (A2)+,D0 ;Ref-Ptr⓪)BEQ delet ;Ist Null: löschen⓪)MOVE.L D0,(A0)+ ;Referenz-Ptr kopieren⓪)BRA next⓪ delet SUBQ.L #2,A0 ;ItemNr wieder weg⓪)BRA next⓪ ⓪ ende MOVE.L A2,D3⓪)SUB.L A0,D3 ;D3 enthält nun Diff. zur neuen Länge (positiv)⓪)MOVE.L D3,ImpOffset ;merken f. FINVAR⓪ ⓪); die Proc-, Modul-, Table- und Var-Verkettungen werden⓪); später in FINVAR korrigiert, ebenso die Längenliste⓪); Auch das Verschieben und die Korrektur der Ptr im Header⓪); kommt erst später.⓪)⓪); Importliste korrigieren⓪)MOVE.L Header,A2⓪)ADDA.L 14(A2),A2 ;^Importliste⓪)MOVE.L CodeStart,A5⓪)⓪ nextkey2 TST.L (A2)+ ;Key⓪)BEQ ende2 ;ende der Importlisten⓪ ImpRest2 MOVE.W (A2)+,D0 ;Namen überspringen⓪)CMP.B #$FE,D0⓪)BCS ImpRest2⓪ next2 TST.W (A2)+ ;ItemNr⓪)BEQ nextkey2 ;Ende dieser Liste⓪);Relozierkette korrigieren⓪)MOVE.L (A2),D1⓪)MOVE.L D1,D0⓪)SUB.L D3,D0⓪)MOVE.L D0,(A2)+⓪)BRA relCont⓪ relNext MOVE.L D1,D0⓪)SUB.L D3,D0⓪)MOVE.L D0,(A0)⓪ relCont LEA 0(A5,D1.L),A0 ;Adr. der vorigen Ref. nach A0⓪)MOVE.L (A0),D1⓪)BNE relNext⓪)BRA next2⓪ ende2⓪)MOVE.L (A7)+,A2⓪ END⓪ END FinImp;⓪ ⓪ PROCEDURE FIKNOT;⓪ BEGIN⓪ ASSEMBLER⓪)BTST #13,D0 ;NUR IMPORTIERTE IDS⓪)BEQ FIKNOT1⓪)CMPI.B #6,D0 ;PROC?⓪)BEQ FIKNOT2⓪)CMPI.B #50,D0 ;CONST?⓪)BEQ FIKNOT5⓪)CMPI.B #17,D0 ;VAR?⓪)BNE FIKNOT1⓪ FIKNOT4 MOVE.L -14-8(A1,D2.L),D1 ;LETZTE REF BEI VAR⓪)BRA FIKNOT3⓪ FIKNOT5 MOVE.L -14-8(A1,D2.L),D1 ;LETZTE REF BEI CONST⓪)BRA FIKNOT3⓪ FIKNOT2 MOVE.L -18-8(A1,D2.L),D1 ;LETZTE REF BEI PROC⓪ FIKNOT3 MOVE.L -06-8(A1,D2.L),D0 ;^IMPORTLISTE (statt Adr.)⓪)MOVE.L D1,0(A2,D0.L) ;EINTRAGEN⓪ FIKNOT1⓪ END⓪ END FIKNOT;⓪ ⓪ ⓪ (*⓪!* EXPORTLISTE NACHARBEITEN⓪!*)⓪ ⓪ PROCEDURE FinExp;⓪ BEGIN⓪ ASSEMBLER⓪); Die Importlist-Korrekturen wurden bei den eigenen IDs⓪); zwar schon schon in FINVar vorgenommen, jedoch nur bei⓪); den abgelegten Werten für die Reloc-List, usw, jedoch⓪); wurden die Original-Einträge bei den IDs nicht korrigiert.⓪); Deshalb jetzt nochmal.⓪)MOVE.L Header,A0⓪)MOVE.L 18(A0),D0⓪)BEQ FinExp2 ;KEINE EXPORTS⓪)MOVE.L 22(A0),D2 ;OFFSET AUF GLOB.VAR⓪);minus der Header-Länge (nun Codelänge):⓪)ADD.L A0,D2⓪)SUB.L CodeStart,D2⓪)ADDA.L D0,A0 ;ABS. ^EXPORTLISTE⓪)MOVE.L ImpOffset,D7⓪ FinExp1 TST.W (A0)+⓪)BEQ FinExp2 ;FERTIG⓪)MOVE.L (A0),D1 ;^ID-Beschreibung⓪)CMPI.B #17,-1(A1,D1.L) ;VAR?⓪)BEQ FinExp3⓪)CMPI.B #50,-1(A1,D1.L) ;CONST?⓪)BEQ FinExp5⓪); Proc⓪)MOVE.L -6(A1,D1.L),D0⓪)SUB.L D7,D0⓪)MOVE.L D0,(A0)+ ;REL.PROC-ADR stattdessen eintragen⓪)BRA FinExp1⓪ FinExp3 ; Var⓪)MOVE.L -6(A1,D1.L),D0 ;alt: Adr. der Var (Offset ab Null)⓪)ADD.L D2,D0⓪); ImpOffset ist hier bereits durch 22(A0) korrigiert⓪)MOVE.L D0,(A0)+ ;neu: Adr. der Var (Offset ab Codelänge)⓪)BRA FinExp1⓪ FinExp5 ; Const⓪)MOVE.L -6(A1,D1.L),D0 ; ADR d. Const (bereits D7-korrigiert)⓪)MOVE.L D0,(A0)+ ;REL.CONST-ADR stattdessen eintragen⓪)BRA FinExp1⓪ FinExp2⓪(END⓪ END FinExp;⓪ ⓪ (*⓪ * ----------------------------------⓪ * Alle Referenzen auf einen Opaque-Typ umhängen,⓪ * wenn dieser nachdeklariert wurde.⓪ * ----------------------------------⓪ *⓪ * (D0,D2)⓪ *⓪ * D2 = rel. ^Beschreibung im ID-Baum + 10⓪ * D1 = zu suchender Opaque-Pointer (der Eintrag ist bereits in⓪ * Relay auf richtigen Typ umgewandelt)⓪ * D0 = Objekt-Kennung.⓪ ⓪'Da TreSrc keine anonymen Einträge erreicht, müssen mögliche⓪'Verweise auf anonyme Einträge von OpqKnot gefunden und verfolgt⓪'werden. Dies sind just die Pointer, die auch direkt auf Opaques⓪'zeigen können - mit Ausnahme der Prozedur- und Parameter-Deskriptoren:⓪'dort zeigen die ^nächsten Parameter evtl. auf anonyme Verwendungen⓪'des Opaques, die ^Typen können EBENFALLS auf anonyme Verwendung⓪'zeigen, nämlich in Open Arrays!⓪'⓪'Beim Verfolgen von POINTER TO RECORD-Strukturen und bei Prozedurtypen⓪'können Endlosschleifen auftreten. Diese werden vermieden durch⓪'Markieren der bearbeiteten Pointer-Einträge in Bit 2 des⓪'Kennungsbytes ("Typ-Eintrag").⓪'⓪'Um die Markierungen anschließend wieder löschen zu können, werden⓪'die markierten Einträge durch eine Pointerkette verbunden. Diese⓪'schreiben wir (ähem) anstelle der Längenangaben (immer 4) in den⓪'Baum.⓪ *)⓪ FORWARD TravTr2;⓪ ⓪ PROCEDURE OpqKnot;⓪ BEGIN⓪ ASSEMBLER⓪ CopInf0 CMP.B #13,D0 ;Record?⓪)BNE CopInf5⓪)⓪); lokalen Baum eines Records scannen⓪)⓪)MOVE.L -22(A1,D2.L),D2 ;^lokalen Baum⓪)BEQ CopInf9 ;wenn leer, dann RTS⓪)JMP TravTr2 ;durchsuchen⓪)⓪); Pointer: Bearbeitung markieren⓪)⓪ CopInf5 CMP.B #19,D0 ;PROCEDURE ?⓪)BEQ CopInf10⓪)CMP.B #20,D0 ;POINTER ?⓪)BNE CopInf8⓪ CopInf10 BCLR #2,-10(A1,D2.L) ;markieren⓪)BEQ CopInf9 ;war schon fertig⓪)MOVE.L D4,-14(A1,D2.L) ;neue Markierung: in Pointerkette⓪)MOVE.L D2,D4⓪)⓪); Beschreibung des Objektes suchen⓪)⓪ CopInf8 LEA OpqUsers(pc),A0 ;Liste mit Item-Beschreibung⓪ CopInf3 CMP.B (A0)+,D0⓪)BEQ CopInf4 ;gefunden⓪)ADDQ.L #3,A0⓪)TST.B (A0) ;Ende der Liste?⓪)BNE CopInf3 ; nein⓪ CopInf9 RTS⓪)⓪ CopInf4 CLR.L D0⓪)MOVE.B (A0)+,D0 ;Pointer-Offset in Beschreibung⓪)SUB.L D2,D0⓪)NEG.L D0⓪)CMP.L -8(A1,D0.L),D1 ;^unseren Opaque-Kandidaten ?⓪)BNE CopInf1 ; nein⓪)⓪); Opaque gefunden⓪)MOVE.L -6(A1,D1.L),-8(A1,D0.L) ;neue Adr aus Relay drüberschreiben⓪)BSR.S CopInf2 ;weitere User prüfen⓪)TST.B (A0) ;Offset zum ^mögl. anonymen Opq-User...⓪)BEQ CopInf9 ; den haben wir schon behandelt⓪)BRA CopInf7⓪ ⓪ CopInf1 BSR.S CopInf2 ;weitere User prüfen⓪ CopInf7 ;^anonymen Opq-User prüfen⓪)CLR.L D2⓪)MOVE.B (A0),D2 ;^mögl. anonymen Opq-User⓪)ADD.L D2,D0⓪)MOVE.L -8(A1,D0.L),D2 ;neuer ^⓪)BEQ CopInf9⓪)MOVE.W -2(A1,D2.L),D0 ;zugeh. Kennung⓪)ADDQ.L #8,D2 ;üblicher Offset in TreSrc⓪)BRA CopInf0⓪ ⓪ CopInf2 MOVEM.L A0/D0/D2,-(A7)⓪)TST.B 1(A0)⓪)BEQ CopInf6⓪); es gibt einen zweiten mögl. ^Opq-User⓪)CLR.L D2⓪)MOVE.B 1(A0),D2⓪)ADD.L D2,D0⓪)MOVE.L -8(A1,D0.L),D2 ;neuer ^⓪)BEQ CopInf6⓪)MOVE.W -2(A1,D2.L),D0 ;zugeh. Kennung⓪)ADDQ.L #8,D2 ;üblicher Offset in TreSrc⓪)BSR CopInf0⓪ CopInf6 MOVEM.L (A7)+,A0/D0/D2⓪)RTS⓪ ⓪); Tabelle: ItemNr, Offset zu ^möglichen Opaquetyp,⓪); Offset von dort zu mögl ^anonymen Opaque-User⓪)⓪ OpqUsers DC.B 6, 14, 4, 0 ;Procedure⓪)DC.B 7, 10, 0, 4 ;Proc.Parameter⓪)DC.B 12, 14, 0, 0 ;Array⓪)DC.B 14, 10, 0, 0 ;Recordfeld⓪)DC.B 17, 10, 0, 0 ;Var⓪)DC.B 18, 6, 0, 0 ;Konstante alt⓪)DC.B 19, 14, 4, 0 ;ProcType⓪)DC.B 20, 10, 0, 0 ;Pointer⓪)DC.B 32, 6, 0, 0 ;Open Array⓪)DC.B 42, 6, 0, 0 ;Long Open Array⓪)DC.B 44, 10, 0, 0 ;ProcType f. lok. Procs⓪)DC.B 50, 10, 0, 0 ;Konstante neu⓪)DC.B 0⓪)SYNC⓪!END⓪ END OpqKnot;⓪ ⓪ (*⓪(speziell für opqKnot:⓪(wie TravTr1, jedoch wird bei Verfolgen eines Relays geprüft,⓪(ob der Verweis direkt auf (A1,D1.L) zeigt (alter Opaque-Eintrag).⓪(⓪(D4 ist zu erhalten (enthält Wurzel der Pointerkette, die die⓪(markierten Einträge verbindet)!⓪!*)⓪ ⓪ PROCEDURE TravTr2;⓪ BEGIN⓪ ASSEMBLER⓪ TravTr1L MOVE.L D2,-(A7)⓪)MOVE.L -4(A1,D2.L),D2 ;LINKEN AST VERFOLGEN⓪)BEQ TravTr2L⓪)BSR TravTr1L⓪ TravTr2L MOVE.L (A7),D2⓪)MOVE.L -8(A1,D2.L),D2 ;RECHTEN AST VERFOLGEN⓪)BEQ TravTr4⓪)BSR TravTr1L⓪ TravTr4 MOVE.L (A7)+,D2⓪ ⓪ TravTr5 SUBQ.L #2,D2 ;ID WEG⓪)CMPI.W #$FE00,-8(A1,D2.L)⓪)BCS TravTr5 ;noch keine Endmarke⓪)⓪)MOVE.W -10(A1,D2.L),D0 ;KENNUNG⓪)TST.B D0⓪)BNE TravTr7 ;KEIN RELAY⓪)MOVE.L -14(A1,D2.L),D0⓪)⓪); Eintrag ist Relay⓪)⓪)CMP.L D1,D0 ;Verweis auf alten Opaque-Typ?⓪)BNE TravTr8⓪)MOVE.L -6(A1,D1.L),D0 ;durch Nachdekl. ersetzen⓪)MOVE.L D0,-14(A1,D2.L)⓪ TravTr8 MOVE.L D0,D2⓪)ADDQ.L #8,D2 ;üblichen Offset wiederherstellen⓪)MOVE.W -10(A1,D2.L),D0⓪ ⓪ TravTr7 CMPI.B #15,D0 ;lokales Modul?⓪)BEQ L3⓪)CMPI.B #16,D0 ;QUALIFIER?⓪)BNE L2⓪ L3 MOVEM.L D0/D2,-(A7)⓪)MOVE.L -14(A1,D2.L),D2⓪)BEQ L4 ;Unterbaum ist leer⓪)JSR TravTr2 ;UNTERBAUM DURCHSUCHEN⓪ L4 MOVEM.L (A7)+,D0/D2⓪ L2 JMP OpqKnot⓪ TravTr6⓪ END⓪ END TravTr2;⓪ ⓪ (* Bei Nachdeklaration eines Opaques Änderung aller bestehenden⓪#Referenzen im globalen Scope veranlassen.⓪#⓪#Das globale Scope muß das oberste auf dem Display Stack sein,⓪#weil nur dort die Nachdeklaration erfolgen kann!⓪#⓪#D1 = zu suchender Opaque-Pointer⓪((der Eintrag ist bereits in Relay auf richtigen Typ umgewandelt)⓪ *)⓪ ⓪ PROCEDURE NewOpaque;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪)MOVE.L (A6),D2 ;globales Level⓪)BEQ opq1 ; ist leer⓪)CLR.L D4 ;Wurzel der Markierungs-Pointerkette⓪)JSR TravTr2⓪)⓪); markierte Typeinträge reparieren⓪)⓪)TST.L D4⓪)BEQ opq1 ;gar kein Eintrag in der Kette⓪)MOVEQ #4,D0⓪#opq2 MOVE.L -14(A1,D4.L),D2⓪)MOVE.L D0,-14(A1,D4.L) ;korrekte Typlänge eintragen⓪)BSET #2,-10(A1,D4.L) ;wieder als Typ markieren⓪)MOVE.L D2,D4⓪)BNE opq2 ; mehr Kettenglieder?⓪)⓪#opq1⓪"END⓪ END NewOpaque;⓪ ⓪ ⓪ (* in lokalen Scopes nach nicht-implementierten⓪#FORWARD-Deklarationen suchen⓪ *)⓪ ⓪ PROCEDURE FwdKnot;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪)CMP.B #6,D0 ;Procedure?⓪)BNE done⓪)TST.L -14(A1,D2.L)⓪)BNE done ;Adresse eingetragen⓪)JSR IDfromTree⓪)MOVE #rUnFw,D5⓪)JMP SyntaxErr⓪ done⓪"END⓪ END FwdKnot;⓪ ⓪ ⓪ PROCEDURE MovParA3Knot; (* /D0/ *)⓪"(* Für Parms auf A3 (Vars sind hier noch nicht deklariert) *)⓪"BEGIN⓪$ASSEMBLER⓪(CMPI.B #17,D0⓪(BNE noVar⓪(MOVE.L -8-6(A1,D2.L),D0 ;Offset der Variablen zu A6⓪(BMI error ;muß erstmal positiv sein⓪(CMPI.W #1,GLOBAL ;lokale Proc?⓪(BEQ isGlobal⓪(SUBQ.L #4,D0 ;dann Offset f. Stat Link abziehen⓪(BCS error⓪&isGlobal⓪(SUB.L ParAdr,D0 ;Offset um Parm-Länge runterschieben⓪(BCC error⓪(MOVE.L D0,-8-6(A1,D2.L)⓪&noVar⓪(RTS⓪&error⓪(TRAP #6⓪(DC.W -112 ;um internen Fehler zu melden⓪$END⓪"END MovParA3Knot;⓪ ⓪ PROCEDURE MovParA7Knot; (* /D0/ *)⓪"(*⓪#* Für Parms auf A7 (Vars sind hier noch nicht deklariert):⓪#* Die Parameter müssen so erhöht werden, daß sie A5-relativ ansprechbar⓪#* sind. Da der Static Link mit verschoben wird, muß lediglich immer⓪#* 8 addiert werden.⓪#*)⓪"BEGIN⓪$ASSEMBLER⓪(CMPI.B #17,D0⓪(BNE noVar⓪(; Parm-Start berechnen in D4⓪(ADDQ.L #8,-8-6(A1,D2.L)⓪&noVar⓪(RTS⓪&error⓪(TRAP #6⓪(DC.W -113 ;um internen Fehler zu melden⓪$END⓪"END MovParA7Knot;⓪ ⓪ PROCEDURE ScanForName;⓪"BEGIN⓪$ASSEMBLER⓪(TST.L D1⓪(BNE cont⓪(CMP.L D3,D2⓪(BEQ found⓪(MOVE.L D4,D2 ;und bei Relays auch diesen Eintrag prüfen⓪ TravTr5 SUBQ.L #2,D2 ;ID WEG⓪(CMPI.W #$FE00,-8(A1,D2.L)⓪(BCS TravTr5 ;noch keine Endmarke⓪(CMP.L D3,D2⓪(BNE cont⓪&found⓪(; gefunden?⓪(CMPI.B #$FE,-9(A1,D4.L) ; ist Name anonym?⓪(BCC cont ; dann weitersuchen⓪(MOVE.L D4,D1⓪&cont⓪$END⓪"END ScanForName;⓪ ⓪ (*⓪!* Findet den Namen eines Idents im Baum, auch von Relays.⓪!* /D0,D4/⓪!* IN:⓪!* (A1,D2.L): Ptr auf Ende der ID-Beschreibung⓪!* OUT:⓪!* (A1,D4.L): Ptr vor Beginn des Namens (steht rückwärts im Speicher!),⓪!* D4 ist Null, wenn ID nicht gefunden⓪!*)⓪ PROCEDURE GetNameOfId;⓪"BEGIN⓪$ASSEMBLER⓪(MOVEM.L D1-D3/A0/A5,-(A7)⓪(MOVE.L D2,D3⓪(ADDQ.L #8,D3⓪(MOVEQ #0,D1⓪(LEA ScanForName,A5⓪(JSR TravTr⓪(TST.L D1⓪(BEQ notfound⓪(SUBQ.L #8,D1⓪¬found⓪(MOVE.L D1,D4⓪(MOVEM.L (A7)+,D1-D3/A0/A5⓪$END⓪"END GetNameOfId;⓪ ⓪ ⓪ FORWARD VerifyTree;⓪ ⓪ PROCEDURE VerifyItem;⓪ BEGIN⓪ ASSEMBLER⓪);D2: ^Eintrag, D0: Kennung⓪)CMPI.B #31,D0⓪)BEQ CopInf4 ;String Const ignorieren⓪)SUBQ.L #2,D2⓪)LEA ITEMS,A0 ;Liste mit Item-Beschreibung⓪)MOVE.B (A0)+,D1⓪ CopInf30 CMP.B D1,D0⓪)BEQ CopInf1 ;gefunden⓪ CopInf20 TST.B (A0)+ ;nicht gefunden: Ende des Eintrags suchen⓪)BNE CopInf20⓪)MOVE.B (A0)+,D1 ;Ende der Liste?⓪)BNE CopInf30 ; nein⓪ ⓪ error JSR IDfromTree⓪)MOVE #rTree,D5 ; ja, exp. Item ist nicht definiert⓪)JMP SyntaxErr⓪ ⓪); Ende der Beschreibung des Items⓪ CopInf4 RTS⓪ ⓪ CopInf1 MOVE.B (A0)+,D0 ;Beschreibung kopieren⓪)BEQ CopInf4 ;fertig⓪)CMPI.B #1,D0 ;Ptr?⓪)BEQ CopInf10⓪)CMPI.B #2,D0 ;Const.L?⓪)BEQ CopInf2⓪)CMPI.B #3,D0 ;Const.W?⓪)BEQ CopInf3⓪)CMPI.B #4,D0 ;Unterbaum?⓪)BEQ CopInf7⓪)CMPI.B #5,D0 ;^ID? (auf 1. Enum-Elem), geht wie Ptr⓪)BEQ CopInf10⓪)CMPI.B #7,D0 ;Insert? -> ignorieren⓪)BEQ CopInf17⓪)CMPI.B #8,D0 ;^ID? (Enum-Elem-Kette), geht wie Ptr⓪)BEQ CopInf10⓪)BRA CopInf4 ;sonst ists eh zu ende⓪ ⓪ CopInf17 MOVEQ #0,D0⓪)MOVE.B (A0)+,D0⓪)SUB.L D0,D2⓪)BRA CopInf1⓪ ⓪ CopInf2 SUBQ.L #4,D2⓪)BRA CopInf1⓪ ⓪ CopInf3 SUBQ.L #2,D2⓪)BRA CopInf1⓪ ⓪ CopInf7 ; Unterbaum prüfen⓪)SUBQ.L #4,D2⓪)MOVEM.L A0/D2,-(A7)⓪)MOVE.L 0(A1,D2.L),D2⓪)BEQ CopInf8 ;Unterbaum ist leer⓪)CMP.L D3,D2 ; durch unsigned Test werden auch pos. Werte erkannt⓪)BCS error⓪)JSR VerifyTree⓪ CopInf8 MOVEM.L (A7)+,A0/D2⓪)BRA CopInf1⓪ ⓪ CopInf10 ; Pointer und ID prüfen⓪)SUBQ.L #4,D2⓪)MOVE.L 0(A1,D2.L),D1⓪)BEQ CopInf1⓪)CMP.L D3,D1 ; durch unsigned Test werden auch pos. Werte erkannt⓪)BCC CopInf1⓪)BRA error⓪"END⓪ END VerifyItem;⓪ ⓪ PROCEDURE VerifyKnot;⓪"BEGIN⓪$ASSEMBLER⓪)CMP.L D3,D4⓪)BCS error ; durch unsigned Test werden auch pos. Werte erkannt⓪)CMP.L D3,D2⓪)BCS error ; durch unsigned Test werden auch pos. Werte erkannt⓪)SUBQ.L #8,D2⓪)JMP VerifyItem⓪'error⓪)JSR IDfromTree⓪)MOVE.W #rTree,D5⓪)JMP SyntaxErr⓪$END⓪"END VerifyKnot;⓪ ⓪ PROCEDURE VerifyTree;⓪"BEGIN⓪$ASSEMBLER⓪); Lokalen Baum prüfen. Adr in D2; Untergrenze in D3⓪)LEA VerifyKnot,A5⓪)JSR TravTr1⓪$END⓪"END VerifyTree;⓪ ⓪ PROCEDURE VerifyWholeTree;⓪"BEGIN⓪$ASSEMBLER⓪); Ganzen Baum prüfen.⓪)MOVE.L TreSpc,D3⓪)LEA VerifyKnot,A5⓪ next MOVE.L (A6)+,D2 ;GLOBAL LEVEL⓪)BMI TravTr8⓪)BEQ next⓪)BRA TravTr9⓪ TravTr8 JSR TravTr1⓪)BRA next⓪ TravTr9 JMP TravTr0⓪$END⓪"END VerifyWholeTree;⓪ ⓪ ⓪ PROCEDURE FCKNOT;⓪ BEGIN ASSEMBLER⓪)CMPI.B #50,D0 ; CONST (neu)⓪)BNE FLKNOT3⓪)BTST #8+4,D0 ; exportiert?⓪)BNE useData ; ja -> in DATA ablegen⓪)BTST #8+5,D0 ; importiert?⓪)BNE FLKNOT3 ; ja -> ignorieren⓪)TST.L -8-14(A1,D2.L) ;^letzte Ref⓪)BEQ FLKNOT3 ; Null -> ignorieren⓪); umkopieren in DATA-Puffer⓪ useData MOVE.L DataPtr,A0⓪)MOVE.W -8-16(A1,D2.L),D0 ;BYTELAENGE⓪)ADDQ #1,D0⓪)BCLR #0,D0⓪)MOVE.W D0,(A0)+ ;Größe d. Konst⓪)MOVE.L -8-14(A1,D2.L),(A0)+ ;^letzte Ref⓪)TST.W D0⓪)BEQ add0w⓪)MOVE.L D2,-(A7)⓪ ConsID3b MOVE.L -8-20(A1,D2.L),(A0)+ ;KONSTANTE AUS BAUM KOPIEREN⓪)SUBQ.L #4,D2⓪)SUBQ.W #4,D0⓪)BGT ConsID3b⓪)BEQ ok2⓪); es sind 2 Byte zuviel kopiert worden⓪)SUBQ.L #2,A0⓪ ok2: MOVE.L (A7)+,D2⓪); Strings im DATA müssen immer 0-terminiert werden:⓪ add0w: MOVE.L -8-10(A1,D2.L),D0 ;Typ⓪)CMP.L StrPtr,D0⓪)BNE notStrng⓪)MOVE.W -8-16(A1,D2.L),D0 ;BYTELAENGE⓪)BEQ add0w2⓪)BTST #0,D0⓪)BEQ isEven⓪); wenn String ungerade Länge hat, einfach letztes Byte löschen⓪)CLR.B -1(A0)⓪)BRA notStrng⓪ FLKNOT3: RTS⓪ isEven ; bei gerader Länge: prüfen, ob 0C am Ende, sonst eins anfügen⓪)TST.B -1(A0)⓪)BEQ notStrng⓪ add0w2: MOVE.L A0,-(A7)⓪)MOVE.L DataPtr,A0⓪)ADDQ.W #2,(A0) ; Länge des Datums im DATA-Puffer um 2 erhöhen⓪)MOVE.L (A7)+,A0⓪)CLR.W (A0)+⓪ notStrng MOVE.L A0,DataPtr⓪)CMPA.L DataEnd,A0⓪)BLS ok⓪)MOVE #rDaSpc,D5 ; DATA-Puffer übergelaufen⓪)JMP SyntaxErr⓪ ok:⓪ END⓪ END FCKNOT;⓪ ⓪ (*⓪!* Die benutzten nicht-importierten CONSTS in den Data-Puffer umtragen⓪!* (wird nur für lokale Levels benutzt - globales wird direkt am Ende⓪!* ohne Umweg über DATA-Puffer an den Code angehängt, damit Speicherplatz⓪!* nicht so sehr verschwendet wird).⓪!*)⓪ ⓪ PROCEDURE FinConst;⓪ BEGIN ASSEMBLER⓪)LEA FCKNOT,A5⓪)MOVE.L (A6),D2⓪)BEQ EMPTY⓪)JMP TravTr1⓪ !EMPTY⓪ END⓪ END FINConst;⓪ ⓪ (*⓪!* Alle Konstanten aus dem DATA-Puffer hinter den Code (A4)⓪!* kopieren und dann Offsets f. Relozierliste festlegen.⓪!* Die Offsets werden, ebenso wie die der Vars, relativ zum Codebeginn⓪!* berechnet. So braucht dann beim Relozieren im Loader keine Fallunter-⓪!* scheidung zw. Code, DATA und Vars gemacht werden. Nur der Linker muß das⓪!* tun, weshalb er dazu im Modulheader die Grenze zw. Code und DATA erhält.⓪!* Das Ganze geschieht in 2 Routinen: Zuerst kopiert FinishData die Daten⓪!* vom Puffer hinter den Code, dann erzeugt RelocData die Relozierliste.⓪!*⓪!* Zusätzlich werden auch die benamten Konstanten aus den globalen Bäumen⓪!* direkt (ohne Umweg über DATA-Puffer) hinter den Code kopiert.⓪!*)⓪ ⓪ PROCEDURE CopyDataToCode;⓪ BEGIN ASSEMBLER⓪)CMPI.B #50,D0 ; CONST (neu)⓪)BNE FLKNOT3⓪)BTST #8+4,D0 ; exportiert?⓪)BNE useData ; ja -> in DATA ablegen⓪)BTST #8+5,D0 ; importiert?⓪)BNE FLKNOT3 ; ja -> ignorieren⓪)TST.L -8-14(A1,D2.L) ;^letzte Ref⓪)BEQ FLKNOT3 ; Null -> ignorieren⓪ useData ; umkopieren in den Code⓪)BSET #2,-8-2(A1,D2.L)⓪)BNE FLKNOT3 ; -> bereits bearbeitet⓪)MOVE.W -8-16(A1,D2.L),D0 ;BYTELAENGE⓪)BEQ add0w⓪)ADDQ #1,D0⓪)BCLR #0,D0⓪)MOVE.W D0,-8-16(A1,D2.L) ;aufgerundete Länge im Tree setzen⓪)MOVE.L D2,-(A7)⓪ ConsID3b MOVE.L -8-20(A1,D2.L),(A4)+ ;KONSTANTE AUS BAUM KOPIEREN⓪)SUBQ.L #4,D2⓪)SUBQ.W #4,D0⓪)BGT ConsID3b⓪)BEQ ok2⓪); es sind 2 Byte zuviel kopiert worden⓪)SUBQ.L #2,A4⓪ ok2: MOVE.L (A7)+,D2⓪); Strings im DATA müssen immer 0-terminiert werden:⓪ add0w: MOVE.L -8-10(A1,D2.L),D0 ;Typ⓪)CMP.L StrPtr,D0⓪)BNE notStrng⓪)MOVE.W -8-16(A1,D2.L),D0 ;BYTELAENGE⓪)BEQ add0w2⓪)BTST #0,D0⓪)BEQ isEven⓪); wenn String ungerade Länge hat, einfach letztes Byte löschen⓪)CLR.B -1(A4)⓪)BRA notStrng⓪ isEven ; bei gerader Länge: prüfen, ob 0C am Ende, sonst eins anfügen⓪)TST.B -1(A4)⓪)BEQ notStrng⓪ add0w2: CLR.W (A4)+⓪)ADDQ.W #2,-8-16(A1,D2.L) ;neue Länge im Tree setzen⓪ notStrng⓪ FLKNOT3:⓪ END⓪ END CopyDataToCode;⓪ ⓪ PROCEDURE FinishData;⓪"BEGIN⓪$ASSEMBLER⓪)MOVEM.L A2-A3,-(A7)⓪)MOVE.L A4,DataCodeOffs⓪)MOVE.L DataStart,A0⓪ lup20: CMPA.L DataPtr,A0⓪)BEQ endOfD2⓪)MOVE.W (A0)+,D0⓪)LSR #1,D0⓪)TST.L (A0)+ ; ^letzte Ref⓪)BEQ lup21 ; -> wenn Null, überspringen⓪)BRA lup23⓪ lup22: MOVE.W (A0)+,(A4)+⓪ lup23: DBRA D0,lup22⓪)BRA lup20⓪ lup21: ADDA.W D0,A0⓪)ADDA.W D0,A0⓪)BRA lup20⓪ endOfD2:⓪); nun auch die globalen CONSTs aus dem Tree umtragen⓪)LEA CopyDataToCode,A5⓪)JSR TravTr ; ALLE verbliebenen Bäume durchgehen⓪)MOVEM.L (A7)+,A2-A3⓪$END⓪"END FinishData;⓪ ⓪ (*EOF*)⓪ ə
